home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / system.mod (.txt) < prev    next >
Oberon Text  |  1996-06-30  |  26KB  |  751 lines
  1. Syntax10.Scn.Fnt
  2. ParcElems
  3. Alloc
  4. Syntax24b.Scn.Fnt
  5. Syntax10i.Scn.Fnt
  6. StampElems
  7. Alloc
  8. 30 Jun 96
  9. Syntax10b.Scn.Fnt
  10. (* AMIGA *)
  11. MODULE System;    (* JG 25.4.90 / NW 22.4.90, JT 21.01.93, CN/SHML 
  12.     IMPORT SYSTEM, Amiga, Kernel, Modules, Files, Input, Viewers, MenuViewers, Oberon, Fonts, Texts, TextFrames;
  13.     CONST
  14.         copyright = "(c) ETH-Zurich / Claudio Nieder, Stefan Ludwig & Ralf Degner";
  15.         SystemMenu = "System.Close System.Copy System.Grow Edit.Search Edit.Store ";
  16.         SystemMenuText = "System.Menu.Text";
  17.         LogMenu = "System.Close System.Grow Edit.Locate Edit.Store ";
  18.         LogMenuText = "Log.Menu.Text";
  19.         (* structure forms *)
  20.         (*Undef = 0; *) Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  21.         Real = 7; LReal = 8; Set = 9; (*String = 10;  NilTyp = 11; NoTyp = 12; *)
  22.         Pointer = 13; ProcTyp = 14; Comp = 15;
  23.         W: Texts.Writer;
  24.     PROCEDURE Str(s: ARRAY OF CHAR);    BEGIN Texts.WriteString(W, s) END Str;
  25.     PROCEDURE Ch(ch: CHAR);    BEGIN Texts.Write(W, ch) END Ch;
  26.     PROCEDURE Integer(i: LONGINT);    BEGIN Texts.Write(W, " "); Texts.WriteInt(W, i, 0) END Integer;
  27.     PROCEDURE Ln;    BEGIN Texts.WriteLn(W) END Ln;
  28.     PROCEDURE Append(t: Texts.Text);    BEGIN ASSERT(t#NIL); Texts.Append(t, W.buf) END Append;
  29.     PROCEDURE Hex(i: LONGINT);    BEGIN Texts.Write(W, " "); Texts.WriteHex(W, i) END Hex;
  30.     PROCEDURE ScanEnd(VAR s: Texts.Scanner; VAR end: LONGINT);    (* Scan first parameter *)
  31.         VAR sel: Texts.Text; beg, time: LONGINT;
  32.     BEGIN
  33.         Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
  34.         IF (s.class = Texts.Char) & (s.c = "^") THEN
  35.             Oberon.GetSelection(sel, beg, end, time);
  36.             IF time >= 0 THEN Texts.OpenScanner(s, sel, beg); Texts.Scan(s) END
  37.         ELSE end := Oberon.Par.text.len
  38.         END
  39.     END ScanEnd;
  40.     PROCEDURE ScanFirst(VAR s: Texts.Scanner);    (* Scan first parameter *)
  41.         VAR sel: Texts.Text; beg, end, time: LONGINT;
  42.     BEGIN
  43.         Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
  44.         IF (s.class = Texts.Char) & (s.c = "^") OR (s.line # 0) THEN
  45.             Oberon.GetSelection(sel, beg, end, time);
  46.             IF time >= 0 THEN Texts.OpenScanner(s, sel, beg); Texts.Scan(s) END
  47.         END
  48.     END ScanFirst;
  49.     PROCEDURE MenuFrame(name, fileName, defaultMenu: ARRAY OF CHAR): TextFrames.Frame;
  50.         VAR mf: TextFrames.Frame; t: Texts.Text; buf: Texts.Buffer;
  51.     BEGIN
  52.         IF Files.Old(fileName) = NIL THEN mf := TextFrames.NewMenu(name, defaultMenu)
  53.         ELSE
  54.             mf := TextFrames.NewMenu(name, "");
  55.             NEW(t); Texts.Open(t, fileName);
  56.             NEW(buf); Texts.OpenBuf(buf); Texts.Save(t, 0, t.len, buf); Texts.Append(mf.text, buf)
  57.         END;
  58.         RETURN mf
  59.     END MenuFrame;
  60.     PROCEDURE Strip(VAR s: ARRAY OF CHAR);
  61.         VAR i: INTEGER;
  62.     BEGIN i := -1; REPEAT INC(i) UNTIL (s[i] = 0X) OR (s[i] = "."); s[i] := 0X
  63.     END Strip;
  64.     PROCEDURE DumpVar(T:Texts.Text; VAR name: ARRAY OF CHAR; fp, f, vadr: LONGINT; varPar: BOOLEAN);
  65.         VAR ch: CHAR; sival: SHORTINT; ival, i: INTEGER; lival: LONGINT; rval: REAL; lrval: LONGREAL;
  66.     BEGIN
  67.         IF ((fp MOD 2) # 0) OR (fp<4096) THEN
  68.             Str(" -- invalid stack frame"); Ln; Append(T); RETURN
  69.         END ;
  70.         IF varPar THEN SYSTEM.GET(fp + vadr, vadr)
  71.         ELSE vadr := fp + vadr
  72.         END ;
  73.         Str("   "); Hex(vadr); Str(" "); Str(name); Str(" = ");
  74.         CASE f OF
  75.         | Byte: SYSTEM.GET(vadr, ch); Integer(ORD(ch))
  76.         | SInt: SYSTEM.GET(vadr, sival); Integer(sival)
  77.         | Int: SYSTEM.GET(vadr, ival); Integer(ival)
  78.         | LInt: SYSTEM.GET(vadr, lival); Integer(lival)
  79.         | Bool: SYSTEM.GET(vadr, sival);
  80.             IF sival = 0 THEN Str("FALSE") ELSE Str("TRUE") END
  81.         | Char: SYSTEM.GET(vadr, ch);
  82.             IF (ch < " ") OR (ch > "~") THEN Str("CHR("); Integer(ORD(ch)); Ch(")")
  83.             ELSE Ch(22X); Ch(ch); Ch(22X)
  84.             END
  85.         | Pointer, ProcTyp, Set: SYSTEM.GET(vadr, lival); Texts.WriteHex(W, lival); Ch("H")
  86.         | Real: SYSTEM.GET(vadr, rval); Texts.WriteReal(W, rval, 15)
  87.         | LReal: SYSTEM.GET(vadr, lrval); Texts.WriteLongReal(W, lrval, 24)
  88.         | Comp: Ch(22X); i := 0;
  89.             LOOP SYSTEM.GET(vadr+i, ch);
  90.                 IF (ch < " ") OR (ch >= 90X) THEN EXIT END ;
  91.                 Ch(ch); INC(i)
  92.             END ;
  93.             Ch(22X)
  94.         ELSE Str("unknown type")
  95.         END ;
  96.         Ln; Append(T)
  97.     END DumpVar;
  98.     PROCEDURE RInt(VAR refs: LONGINT; VAR k: LONGINT);
  99.         VAR n: LONGINT; shift: SHORTINT; x: CHAR;
  100.     BEGIN
  101.         shift := 0; n := 0; SYSTEM.GET(refs, x); INC(refs);
  102.         WHILE ORD(x) >= 128 DO
  103.             INC(n, ASH(ORD(x) MOD 128, shift));
  104.             INC(shift, 7); SYSTEM.GET(refs, x); INC(refs)
  105.         END ;
  106.         k := n + ASH(ORD(x) MOD 64, shift) - ASH(ORD(x) DIV 64, shift) * 64
  107.     END RInt;
  108.     PROCEDURE RName(VAR refs: LONGINT; VAR name: ARRAY OF CHAR);
  109.         VAR i: INTEGER; ch: CHAR;
  110.     BEGIN i := 0; REPEAT SYSTEM.GET(refs, ch); name[i] := ch; INC(i); INC(refs) UNTIL ch = 0X
  111.     END RName;
  112.     PROCEDURE DumpProc(T:Texts.Text; fp, pc: LONGINT);
  113.         VAR m: Kernel.Module; found: BOOLEAN;
  114.             refs, refsend, vadr, lastadr, adr: LONGINT;
  115.             name: ARRAY 64 OF CHAR;
  116.             f: SHORTINT; b: CHAR;
  117.     BEGIN
  118.         m := Kernel.modules;
  119.         WHILE m # NIL DO
  120.             IF (pc >= m.code) & (pc < m.refs) THEN (*module found*)
  121.                 refs := m^.refs + 1; refsend := m^.refs + m^.refSize; lastadr := 0;
  122.                 WHILE refs < refsend DO
  123.                     RInt(refs, adr);
  124.                     RName(refs, name);
  125.                     IF (pc < m.code + adr) & (pc >= m.code + lastadr) THEN found := TRUE;
  126.                         Str(m.name); Ch("."); Str(name);
  127.                         Ch(9X); Integer(pc - m.code); Ln; Append(T);
  128.                         IF name[0] = "$" THEN fp := m^.data END
  129.                     ELSE found := FALSE
  130.                     END ;
  131.                     LOOP
  132.                         IF refs >= refsend THEN EXIT END ;
  133.                         SYSTEM.GET(refs, b); INC(refs);
  134.                         IF ORD(b) = 0F8H THEN EXIT END ;
  135.                         SYSTEM.GET(refs, f); INC(refs);
  136.                         RInt(refs, vadr);
  137.                         RName(refs, name);
  138.                         IF found THEN DumpVar(T, name, fp, f, vadr, ORD(b) = 3) END
  139.                     END ;
  140.                     IF found THEN RETURN ELSE lastadr := adr END
  141.                 END
  142.             ELSE m := m.link
  143.             END
  144.         END ;
  145.         Str("unknown"); Ln; Append(T)
  146.     END DumpProc;
  147.     PROCEDURE -RTS 04EH, 075H;
  148.     PROCEDURE Trap;
  149.         VAR errorFrame: Amiga.ErrorFrame; x, y, s: INTEGER; v: Viewers.Viewer; PC, FP: LONGINT; t:Texts.Text;
  150.     BEGIN
  151.         Amiga.RestoreTrapHandler;
  152.         Amiga.GetErrorFrame(errorFrame);
  153.         Str("Trap occurred: PC ="); Integer(errorFrame.PC);
  154.         Str(" SP ="); Integer(errorFrame.SP);
  155.         Str(" type ="); Integer(errorFrame.type);
  156.         Str(" val ="); Integer(errorFrame.val);
  157.         Ln; Append(Oberon.Log);
  158.         t := TextFrames.Text("");
  159.         Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y);
  160.         v := MenuViewers.New(
  161.             MenuFrame("System.Trap", SystemMenuText, SystemMenu),
  162.             TextFrames.NewText(t, 0),
  163.             TextFrames.menuH, x, y
  164.         PC := errorFrame.PC;
  165.         FP := errorFrame.FP;
  166.         IF v.state > 0 THEN
  167.             Str("TRAP "); Integer(errorFrame.type);
  168.             Str("  code = "); Integer(errorFrame.val);
  169.             Str("  PC = "); Texts.WriteHex(W, PC);
  170.             Str("  FP = "); Texts.WriteHex(W, FP);
  171.             Str("  SP = "); Texts.WriteHex(W, errorFrame.SP);
  172.             Ln; Append(t);
  173.             IF errorFrame.type = Amiga.TrapErr THEN
  174.                 CASE errorFrame.val OF
  175.                 | 2: Str("Bus error")
  176.                 | 3: Str("Address error")
  177.                 | 4: Str("Illegal instruction")
  178.                 | 5: Str("Zero divide")
  179.                 | 6: Str("CHK, CHK2 instruction");
  180.                     Texts.WriteLn(W);
  181.                     Str("Oberon Trap: Index out of range / Invalid case in WITH statement")
  182.                 | 7: Str("TRAPV, TRAPcc, cpTRAPcc instruction");
  183.                     SYSTEM.GET(PC-2, s);
  184.                     Texts.WriteLn(W);
  185.                     Str("Oberon Trap ");Texts.WriteInt(W, s, 1);Str(" : ");
  186.                     CASE s OF
  187.                         0 : Str("ASSERT fault")
  188.                        |1 : Str("Parity error  (NMI)")
  189.                        |2 : Str("Illegal address (NIL-reference)")
  190.                        |3 : Str("FPU error  (inspect FSR)")
  191.                        |4 : Str("Illegal instruction")
  192.                        |5 : Str("Illegal SVC number")
  193.                        |6 : Str("Division by zero")
  194.                        |7 : Str("Flag trap, invalid index, integer overflow")
  195.                        |9 : Str("Trace trap")
  196.                        |10 : Str("Undefined instruction")
  197.                        |11 : Str("Restartable bus error")
  198.                        |12 : Str("Nonrestartable bus error")
  199.                        |13 : Str("Integer overflow trap or invalid index trap")
  200.                        |14 : Str("Debug trap")
  201.                        |15 : Str("Index out of range / Invalid case in WITH statement")
  202.                        |16 : Str("Invalid case in CASE statement")
  203.                        |17 : Str("Function procedure without RETURN statement")
  204.                        |18 : Str("Type guard check")
  205.                        |19 : Str("Implied type guard check in record assignment")
  206.                        |20 : Str("Disk drive error (unreadable sector)")
  207.                        |21 : Str("Parity error in sector address")
  208.                        |22 : Str("Disk full")
  209.                        |23 : Str("File too long  (> 2.5 MB)")
  210.                        |24 : Str("Abort from keyboard")
  211.                        |25 : Str("ReadBytes/WriteBytes(R, a, n):  LEN(a) < n")
  212.                        |27 : Str("Illegal function argument (Math or MathL)")
  213.                        |30..255 : Str("Programmed HALT")
  214.                     ELSE
  215.                         Str("unknown")
  216.                     END
  217.                 | 8: Str("Privilege violation")
  218.                 | 9: Str("Trace")
  219.                 | 10: Str("Line 1010 emulator")
  220.                 | 11: Str("Line 1111 emulator")
  221.                 | 13: Str("Coprocessor protocol violation")
  222.                 | 14: Str("Format error")
  223.                 | 32..47: Str("TRAP instruction"); Integer(errorFrame.val-32)
  224.                 ELSE Str("Some error"); Integer(errorFrame.val)
  225.                 END
  226.             ELSE Str("Some other error"); Integer(errorFrame.val)
  227.             END;
  228.             Ln; Append(t);
  229.             LOOP
  230.                 IF (FP<4096) OR (PC<4096) THEN EXIT; END;
  231.                 DumpProc(t, FP, PC);
  232.                 Append(t);
  233.                 IF FP >= Amiga.stackPtr THEN EXIT; END;
  234.                 SYSTEM.GET(FP+4, PC);
  235.                 SYSTEM.GET(FP, FP)
  236.             END
  237.         END;
  238.         Amiga.InstallTrapHandler(Trap);
  239.         SYSTEM.PUTREG(15, Amiga.stackPtr); RTS
  240.     END Trap;
  241.     PROCEDURE Max (i, j: LONGINT): LONGINT;
  242.     BEGIN IF i >= j THEN RETURN i ELSE RETURN j END
  243.     END Max;
  244.     PROCEDURE Open*;
  245.         VAR par: Oberon.ParList;
  246.             T: Texts.Text;
  247.             S: Texts.Scanner;
  248.             V: Viewers.Viewer;
  249.             X, Y: INTEGER;
  250.             beg, end, time: LONGINT;
  251.     BEGIN
  252.         par := Oberon.Par;
  253.         Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
  254.         IF (S.class = Texts.Char) & (S.c = "^") OR (S.line # 0) THEN
  255.             Oberon.GetSelection(T, beg, end, time);
  256.             IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
  257.         END;
  258.         IF S.class = Texts.Name THEN
  259.             Oberon.AllocateSystemViewer(par.vwr.X, X, Y);
  260.             V := MenuViewers.New(
  261.                 MenuFrame(S.s, SystemMenuText, SystemMenu),
  262.                 TextFrames.NewText(TextFrames.Text(S.s), 0),
  263.                 TextFrames.menuH, X, Y
  264.         END
  265.     END Open;
  266.     PROCEDURE OpenLog*;
  267.         VAR logV: Viewers.Viewer; X, Y: INTEGER;
  268.     BEGIN
  269.         Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y);
  270.         logV := MenuViewers.New(
  271.             MenuFrame("System.Log", LogMenuText, LogMenu),
  272.             TextFrames.NewText(Oberon.Log, Max(0, Oberon.Log.len - 200)),
  273.             TextFrames.menuH, X, Y
  274.     END OpenLog;
  275.     PROCEDURE Close*;
  276.         VAR par: Oberon.ParList; V: Viewers.Viewer;
  277.     BEGIN
  278.         par := Oberon.Par;
  279.         IF par.frame = par.vwr.dsc THEN V := par.vwr
  280.         ELSE V := Oberon.MarkedViewer()
  281.         END;
  282.         Viewers.Close(V)
  283.     END Close;
  284.     PROCEDURE CloseTrack*;
  285.         VAR V: Viewers.Viewer;
  286.     BEGIN V := Oberon.MarkedViewer(); Viewers.CloseTrack(V.X)
  287.     END CloseTrack;
  288.     PROCEDURE Recall*;
  289.         VAR V: Viewers.Viewer; M: Viewers.ViewerMsg;
  290.     BEGIN
  291.         Viewers.Recall(V);
  292.         IF (V # NIL) & (V.state = 0) THEN
  293.             Viewers.Open(V, V.X, V.Y + V.H); M.id := Viewers.restore; V.handle(V, M)
  294.         END
  295.     END Recall;
  296.     PROCEDURE Copy*;
  297.         VAR V, V1: Viewers.Viewer; M: Oberon.CopyMsg; N: Viewers.ViewerMsg;
  298.     BEGIN
  299.         V := Oberon.Par.vwr; V.handle(V, M); V1 := M.F(Viewers.Viewer);
  300.         Viewers.Open(V1, V.X, V.Y + V.H DIV 2);
  301.         N.id := Viewers.restore; V1.handle(V1, N)
  302.     END Copy;
  303.     PROCEDURE Grow*;
  304.         VAR V, V1: Viewers.Viewer; M: Oberon.CopyMsg; N: Viewers.ViewerMsg;
  305.             DW, DH: INTEGER;
  306.     BEGIN V := Oberon.Par.vwr;
  307.         DW := Oberon.DisplayWidth(V.X); DH := Oberon.DisplayHeight(V.X);
  308.         IF V.H < DH - Viewers.minH THEN Oberon.OpenTrack(V.X, V.W)
  309.         ELSIF V.W < DW THEN Oberon.OpenTrack(Oberon.UserTrack(V.X), DW)
  310.         END;
  311.         IF (V.H < DH - Viewers.minH) OR (V.W < DW) THEN
  312.             V.handle(V, M); V1 := M.F(Viewers.Viewer);
  313.             Viewers.Open(V1, V.X, DH);
  314.             N.id := Viewers.restore; V1.handle(V1, N)
  315.         END
  316.     END Grow;
  317.     PROCEDURE SetFont*;
  318.         VAR s: Texts.Scanner;
  319.     BEGIN
  320.         ScanFirst(s);
  321.         IF s.class = Texts.Name THEN Oberon.SetFont(Fonts.This(s.s)) END
  322.     END SetFont;
  323.     PROCEDURE SetColor*;
  324.         VAR s: Texts.Scanner;
  325.     BEGIN
  326.         ScanFirst(s);
  327.         IF s.class = Texts.Int THEN Oberon.SetColor(SHORT(SHORT(s.i))) END
  328.     END SetColor;
  329.     PROCEDURE SetOffset*;
  330.         VAR s: Texts.Scanner;
  331.     BEGIN
  332.         ScanFirst(s);
  333.         IF s.class = Texts.Int THEN Oberon.SetOffset(SHORT(SHORT(s.i))) END
  334.     END SetOffset;
  335.     PROCEDURE Time*;
  336.         VAR par: Oberon.ParList;
  337.             S: Texts.Scanner;
  338.             t, d, hr, min, sec, yr, mo, day: LONGINT;
  339.     BEGIN par := Oberon.Par;
  340.         Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
  341.         IF S.class = Texts.Int THEN (*set date*)
  342.             day := S.i; Texts.Scan(S); mo := S.i; Texts.Scan(S); yr := S.i; Texts.Scan(S);
  343.             hr := S.i; Texts.Scan(S); min := S.i; Texts.Scan(S); sec := S.i;
  344.             t := (hr*64 + min)*64 + sec; d := (yr*16 + mo)*32 + day;
  345.             Kernel.SetClock(t, d)
  346.         ELSE (*read date*)
  347.             Str("System.Time");
  348.             Oberon.GetClock(t, d); Texts.WriteDate(W, t, d); Ln; Append(Oberon.Log)
  349.         END
  350.     END Time;
  351.     PROCEDURE Watch*;
  352.     BEGIN
  353.         Str("System.Watch"); Ln;
  354.         Integer(Kernel.allocated); Str(" bytes allocated from ");
  355.         Integer(Kernel.heapSize); Ln;
  356.         Integer(Kernel.nofiles); Str(" file(s) open"); Ln;
  357.         Append(Oberon.Log)
  358.     END Watch;
  359.     PROCEDURE Collect*;
  360.     BEGIN
  361.         Oberon.Collect(0);
  362.     END Collect;
  363.     PROCEDURE FreeMod(VAR S: Texts.Scanner);
  364.     BEGIN
  365.         Str(S.s); Str(" unloading");
  366.         Append(Oberon.Log);
  367.         IF S.nextCh # "*" THEN Modules.Free(S.s, FALSE)
  368.         ELSE Modules.Free(S.s, TRUE); Texts.Scan(S); Str(" all")
  369.         END;
  370.         IF Modules.res # 0 THEN Str(" failed"); Modules.res := 0 END;
  371.         Ln; Append(Oberon.Log)
  372.     END FreeMod;
  373.     PROCEDURE Free*;
  374.         VAR par: Oberon.ParList;
  375.             T: Texts.Text;
  376.             S: Texts.Scanner;
  377.             beg, end, time: LONGINT;
  378.     BEGIN
  379.         par := Oberon.Par;
  380.         Str("System.Free"); Ln; Append(Oberon.Log);
  381.         Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
  382.         WHILE S.class = Texts.Name DO FreeMod(S); Texts.Scan(S) END;
  383.         IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(T, beg, end, time);
  384.             IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S);
  385.                  IF S.class = Texts.Name THEN FreeMod(S) END
  386.             END
  387.         END
  388.     END Free;
  389.     PROCEDURE ShowModules*;
  390.         VAR T: Texts.Text;
  391.             V: Viewers.Viewer;
  392.             M: Kernel.Module;
  393.             X, Y: INTEGER;
  394.     BEGIN
  395.         T := TextFrames.Text("");
  396.         Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y);
  397.         V := MenuViewers.New(
  398.             MenuFrame("System.ShowModules", SystemMenuText, SystemMenu),
  399.             TextFrames.NewText(T, 0),
  400.             TextFrames.menuH, X, Y
  401.         M := Kernel.modules;
  402.         WHILE M # NIL DO
  403.             Str(M.name); Texts.WriteInt(W, M.refs - M.code, 8);
  404.             Texts.WriteInt(W, M.refcnt, 4); Ln;
  405.             M := M.link
  406.         END;
  407.         Append(T)
  408.     END ShowModules;
  409.     PROCEDURE ShowCommands*;
  410.         VAR M: Kernel.Module; S: Texts.Scanner; i: LONGINT;
  411.             T: Texts.Text; V: Viewers.Viewer; X, Y: INTEGER;
  412.             cmds: POINTER TO ARRAY 1000 OF RECORD
  413.                 name: ARRAY 24 OF CHAR;
  414.                 offset: LONGINT
  415.             END ;
  416.     BEGIN
  417.         ScanFirst(S);
  418.         IF S.class = Texts.Name THEN
  419.             Strip(S.s); M := Modules.ThisMod(S.s);
  420.             IF M # NIL THEN SYSTEM.GET(SYSTEM.ADR(M.commands), cmds); i := 0;
  421.                 Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y);
  422.                 T := TextFrames.Text("");
  423.                 V := MenuViewers.New(
  424.                     MenuFrame("System.Commands", SystemMenuText, SystemMenu),
  425.                     TextFrames.NewText(T, 0),
  426.                     TextFrames.menuH, X, Y
  427.                 );
  428.                 WHILE i < M.nofcoms DO
  429.                     Str(M.name); Ch("."); Str(cmds[i].name); Ln;
  430.                     INC(i)
  431.                 END ;
  432.                 Append(T)
  433.             END
  434.         END
  435.     END ShowCommands;
  436.     PROCEDURE State*;
  437.         VAR
  438.             t: Texts.Text;
  439.             S: Texts.Scanner;
  440.             V: Viewers.Viewer;
  441.             mod: Kernel.Module;
  442.             X, Y: INTEGER;
  443.             refs, refsend, adr: LONGINT;
  444.             f: SHORTINT; b: CHAR;
  445.             name: ARRAY 32 OF CHAR;
  446.     BEGIN
  447.         ScanFirst(S);
  448.         Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y);
  449.         t := TextFrames.Text("");
  450.         V := MenuViewers.New(
  451.             MenuFrame("System.State", SystemMenuText, SystemMenu),
  452.             TextFrames.NewText(t, 0),
  453.             TextFrames.menuH, X, Y
  454.         WHILE S.class = Texts.Name DO
  455.             Strip(S.s);    (*<<*)
  456.             Str(S.s);
  457.             mod := Kernel.modules;
  458.             WHILE (mod # NIL) & (mod.name # S.s) DO mod := mod.link END ;
  459.             IF mod # NIL THEN
  460.                 Ln;
  461.                 refs := mod^.refs + 1; refsend := mod^.refs + mod^.refSize;
  462.                 RInt(refs, adr); RName(refs, name);
  463.                 LOOP
  464.                     IF refs >= refsend THEN EXIT END ;
  465.                     SYSTEM.GET(refs, b); INC(refs);
  466.                     IF ORD(b) = 0F8H THEN EXIT END ;
  467.                     SYSTEM.GET(refs, f); INC(refs);
  468.                     RInt(refs, adr); RName(refs, name);
  469.                     IF adr < 0 THEN DumpVar(t, name, mod.data, f, adr, ORD(b) = 3) END
  470.                 END
  471.             ELSE Str(" not loaded")
  472.             END ;
  473.             Ln; Append(t); Texts.Scan(S)
  474.         END
  475.     END State;
  476.     PROCEDURE SetUser*;
  477.         VAR i: INTEGER; ch: CHAR;
  478.             user: ARRAY 8 OF CHAR;
  479.             password: ARRAY 16 OF CHAR;
  480.     BEGIN
  481.         i := 0; Input.Read(ch);
  482.         WHILE (ch # "/") & (i < 7) DO user[i] := ch; INC(i); Input.Read(ch) END;
  483.         user[i] := 0X;
  484.         i := 0; Input.Read(ch);
  485.         WHILE (ch > " ") & (i < 15) DO password[i] := ch; INC(i); Input.Read(ch) END;
  486.         password[i] := 0X;
  487.         Oberon.SetUser(user, password)
  488.     END SetUser;
  489.     PROCEDURE CurrentDirectory*;
  490.     BEGIN
  491.         Str("System.CurrentDirectory "); Str(Files.CurrentDir); Ln; Append(Oberon.Log)
  492.     END CurrentDirectory;
  493.     PROCEDURE ChangeDirectory*;
  494.         VAR
  495.             S: Texts.Scanner;
  496.             res: INTEGER;
  497.     BEGIN
  498.         ScanFirst(S);
  499.         IF (S.class = Texts.Name) & (S.line = 0) THEN
  500.             Str("System.ChangeDirectory "); Str(S.s);
  501.             Files.ChangeDirectory(S.s, res);
  502.             IF res # 0 THEN Str("  -- failed") END ;
  503.             Ln; Append(Oberon.Log)
  504.         END
  505.     END ChangeDirectory;
  506.     PROCEDURE CopyFile (name: ARRAY OF CHAR; VAR S: Texts.Scanner);
  507.         VAR f, g: Files.File; Rf, Rg: Files.Rider; ch: CHAR;
  508.     BEGIN Texts.Scan(S);
  509.         IF (S.class = Texts.Char) & (S.c = "=") THEN Texts.Scan(S);
  510.             IF (S.class = Texts.Char) & (S.c = ">") THEN Texts.Scan(S);
  511.                 IF S.class = Texts.Name THEN
  512.                     Str(name); Str(" => "); Str(S.s);
  513.                     Str(" copying");
  514.                     Append(Oberon.Log);
  515.                     f := Files.Old(name);
  516.                     IF f # NIL THEN g := Files.New(S.s);
  517.                         Files.Set(Rf, f, 0); Files.Set(Rg, g, 0);
  518.                         Files.Read(Rf, ch);
  519.                         WHILE ~Rf.eof DO Files.Write(Rg, ch); Files.Read(Rf, ch) END;
  520.                         Files.Register(g)
  521.                     ELSE Str(" failed")
  522.                     END;
  523.                     Ln; Append(Oberon.Log)
  524.                 END
  525.             END
  526.         END
  527.     END CopyFile;
  528.     PROCEDURE CopyFiles*;
  529.         VAR par: Oberon.ParList;
  530.         T: Texts.Text;
  531.         S: Texts.Scanner;
  532.         beg, end, time: LONGINT;
  533.     BEGIN
  534.         par := Oberon.Par;
  535.         Str("System.CopyFiles"); Ln; Append(Oberon.Log);
  536.         Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
  537.         WHILE S.class = Texts.Name DO CopyFile(S.s, S); Texts.Scan(S) END;
  538.         IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(T, beg, end, time);
  539.             IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S);
  540.                 IF S.class = Texts.Name THEN CopyFile(S.s, S) END
  541.             END
  542.         END
  543.     END CopyFiles;
  544.     PROCEDURE RenameFile (name: ARRAY OF CHAR; VAR S: Texts.Scanner);
  545.         VAR res: INTEGER;
  546.     BEGIN Texts.Scan(S);
  547.         IF (S.class = Texts.Char) & (S.c = "=") THEN Texts.Scan(S);
  548.             IF (S.class = Texts.Char) & (S.c = ">") THEN Texts.Scan(S);
  549.                 IF S.class = Texts.Name THEN
  550.                     Str(name); Str(" => "); Str(S.s); Str(" renaming"); Append(Oberon.Log);
  551.                     Files.Rename(name, S.s, res);
  552.                     IF res > 1 THEN Str(" failed") END;
  553.                     Ln; Append(Oberon.Log)
  554.                 END
  555.             END
  556.         END
  557.     END RenameFile;
  558.     PROCEDURE RenameFiles*;
  559.         VAR par: Oberon.ParList;
  560.             T: Texts.Text;
  561.             S: Texts.Scanner;
  562.             beg, end, time: LONGINT;
  563.     BEGIN
  564.         par := Oberon.Par;
  565.         Str("System.RenameFiles"); Ln; Append(Oberon.Log);
  566.         Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
  567.         WHILE S.class = Texts.Name DO RenameFile(S.s, S); Texts.Scan(S) END;
  568.             IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(T, beg, end, time);
  569.                 IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S);
  570.                     IF S.class = Texts.Name THEN RenameFile(S.s, S) END
  571.                 END
  572.             END
  573.     END RenameFiles;
  574.     PROCEDURE DeleteFiles*;    (** {name} "~" | "^"    Delete file name **)
  575.         VAR S: Texts.Scanner; end: LONGINT; res: INTEGER;
  576.     BEGIN
  577.         ScanEnd(S, end); Str("System.DeleteFiles"); Ln; Append(Oberon.Log);
  578.         LOOP
  579.             IF S.class # Texts.Name THEN EXIT END;
  580.             Str("deleting "); Files.Delete(S.s, res); Str(S.s);
  581.             IF res # 0 THEN Str(" failed") END;
  582.             Ln; Append(Oberon.Log);
  583.             IF Texts.Pos(S) >= end THEN EXIT END;
  584.             Texts.Scan(S)
  585.         END;
  586.         Append(Oberon.Log)
  587.     END DeleteFiles;
  588.     PROCEDURE Quit*;
  589.     BEGIN
  590.         Amiga.Terminate()
  591.     END Quit;
  592.     PROCEDURE ShowFile(title,name:ARRAY OF CHAR);
  593.     CONST
  594.         bufLen=4000;
  595.         blk:LONGINT;
  596.         buf:ARRAY bufLen OF CHAR;
  597.         ch:CHAR;
  598.         f:Files.File;
  599.         i:LONGINT;
  600.         len:LONGINT;
  601.         r:Files.Rider;
  602.         t:Texts.Text;
  603.         v:Viewers.Viewer;
  604.         x,y:INTEGER;
  605.     BEGIN
  606.         f:=Files.Old(name);
  607.         IF (f#NIL) & (Files.Length(f)>0) THEN    (*<< CN*)
  608.             t:=TextFrames.Text("");
  609.             Oberon.AllocateSystemViewer(Oberon.Par.vwr.X,x,y);
  610.             v:=MenuViewers.New(
  611.                 MenuFrame(title,SystemMenuText,SystemMenu),
  612.                 TextFrames.NewText(t,0),
  613.                 TextFrames.menuH,x,y
  614.             );
  615.             len:=Files.Length(f); blk:=len MOD bufLen; Files.Set(r,f,0);
  616.             WHILE len>0 DO
  617.                 Files.ReadBytes(r,buf,blk); DEC(len,blk);
  618.                 FOR i:=0 TO blk-1 DO
  619.                     ch:=buf[i];
  620.                     IF ch=0AX THEN ch:=0DX END;    (* LF -> CR *)
  621.                     Ch(ch);
  622.                 END;
  623.                 Append(t);
  624.                 blk:=bufLen;
  625.             END;
  626.             Files.Close(f);
  627.             Files.Purge(f)
  628.         END
  629.     END ShowFile;
  630.     PROCEDURE DeleteError(fileName: ARRAY OF CHAR);
  631.     BEGIN
  632.         Str("System.DosCall: Delete "); Str(fileName);
  633.         Str(" failed"); Ln; Append(Oberon.Log);
  634.     END DeleteError;
  635.     PROCEDURE DosCallError(fileName: ARRAY OF CHAR);
  636.     BEGIN
  637.         Str("System.DosCall: "); Str(fileName);
  638.         Str(" failed"); Ln; Append(Oberon.Log);
  639.     END DosCallError;
  640.     PROCEDURE DosCall(cmd,title:ARRAY OF CHAR; sort:BOOLEAN);
  641.     CONST
  642.         SortName="T:System.DosCall.Sort";
  643.         TempName="T:System.DosCall";
  644.         res:INTEGER;
  645.     BEGIN
  646.         Amiga.DosCmd(cmd,TempName,res);
  647.         IF res=0 THEN
  648.             IF (res=0) & sort THEN Amiga.DosCmd("sort T:System.DosCall T:System.DosCall.Sort","NIL:",res) END;
  649.             IF res = 0 THEN
  650.                 IF sort THEN ShowFile(title,SortName) ELSE ShowFile(title,TempName) END
  651.             END;
  652.             Kernel.GC(TRUE);
  653.             Files.Delete(TempName,res);
  654.             IF res#0 THEN DeleteError(TempName); END;
  655.             IF sort THEN
  656.                 Files.Delete(SortName,res);
  657.                 IF res#0 THEN DeleteError(SortName) END
  658.             END
  659.         ELSE
  660.             DosCallError(cmd)
  661.         END
  662.     END DosCall;
  663.     PROCEDURE Execute*;
  664.         VAR par: Oberon.ParList;
  665.             R: Texts.Reader; t: Texts.Text;
  666.             i, beg, end, time: LONGINT;
  667.             cmd: ARRAY 4096 OF CHAR;
  668.             ch: CHAR;
  669.     BEGIN
  670.         par := Oberon.Par;
  671.         Texts.OpenReader(R, par.text, par.pos);
  672.         i := 0; cmd := ""; Texts.Read(R, ch);
  673.         WHILE ch = " " DO Texts.Read(R, ch) END ;
  674.         WHILE (ch >= " ") & (ch # "^") DO cmd[i] := ch; INC(i); Texts.Read(R, ch) END ;
  675.         IF (i = 0) OR (ch = "^") THEN
  676.             Oberon.GetSelection(t, beg, end, time);
  677.             IF time >= 0 THEN Texts.OpenReader(R, t, beg);
  678.                 Texts.Read(R, ch);
  679.                 WHILE Texts.Pos(R) <= end DO
  680.                     IF ch = 0DX THEN ch := " " END ;
  681.                     cmd[i] := ch; INC(i); Texts.Read(R, ch)
  682.                 END
  683.             END
  684.         END ;
  685.         cmd[i] := 0X;
  686.         DosCall(cmd,"System.Execute",FALSE);
  687.         Kernel.GC(TRUE)
  688.     END Execute;
  689.     PROCEDURE Directory*;
  690.         CONST CmdText = "list lformat=%f%n "; CmdLen = 18;
  691.         VAR
  692.             text: Texts.Text; cmd: ARRAY 256 OF CHAR;
  693.             i: INTEGER; time, beg, end: LONGINT;
  694.         PROCEDURE ReadParameters(t: Texts.Text; pos: LONGINT);
  695.             VAR r: Texts.Reader; ch: CHAR;
  696.         BEGIN
  697.             Texts.OpenReader(r, t, pos); Texts.Read(r, ch);
  698.             WHILE ~r.eot & ((ch = " ") OR (ch = 09X)) DO Texts.Read(r, ch) END;
  699.             i := CmdLen;
  700.             WHILE ~r.eot & (i < LEN(cmd)-2) & (ch > " ") DO
  701.                 IF ch = "*" THEN cmd[i] := "#"; cmd[i+1] := "?"; INC(i, 2) ELSE cmd[i] := ch; INC(i) END;
  702.                 Texts.Read(r, ch)
  703.             END;
  704.             cmd[i] := 0X
  705.         END ReadParameters;
  706.     BEGIN
  707.         cmd := CmdText;
  708.         ReadParameters(Oberon.Par.text, Oberon.Par.pos);
  709.         IF (i = CmdLen) OR (cmd[CmdLen] = "^") THEN
  710.             Oberon.GetSelection(text, beg, end, time);
  711.             IF time >= 0 THEN
  712.                 ReadParameters(text, beg)
  713.             ELSE
  714.                 Str("No Selection !");Ln;Append(Oberon.Log); RETURN
  715.             END
  716.         END;
  717.         DosCall(cmd, "System.Directory", TRUE);
  718.         Kernel.GC(TRUE)
  719.     END Directory;
  720.     PROCEDURE Init;
  721.         VAR t, d: LONGINT;
  722.     BEGIN
  723.         Amiga.InstallTrapHandler(Trap);
  724.         Oberon.User := "";
  725.         Oberon.GetClock(t, d);
  726.         Str(Amiga.version); Ln; Str(copyright); Ln;
  727.         Texts.WriteDate(W, t, d); Ln; Append(Oberon.Log);
  728.         CurrentDirectory
  729.     END Init;
  730.     PROCEDURE OpenViewers;
  731.         VAR logV, toolV: Viewers.Viewer; X, Y: INTEGER;
  732.     BEGIN
  733.         Oberon.AllocateSystemViewer(0, X, Y);
  734.         logV := MenuViewers.New(
  735.             MenuFrame("System.Log", LogMenuText, LogMenu),
  736.             TextFrames.NewText(Oberon.Log, 0),
  737.             TextFrames.menuH, X, Y
  738.         Oberon.AllocateSystemViewer(0, X, Y);
  739.         toolV := MenuViewers.New(
  740.             MenuFrame("System.Tool", SystemMenuText, SystemMenu),
  741.             TextFrames.NewText(TextFrames.Text("System.Tool"), 0),
  742.             TextFrames.menuH, X, Y
  743.     END OpenViewers;
  744. BEGIN
  745.     Texts.OpenWriter(W);
  746.     Oberon.Log := TextFrames.Text("");
  747.     Init;
  748.     IF Modules.ThisMod("Configuration") = NIL THEN OpenViewers END;
  749.     Amiga.SystemHere;
  750. END System.
  751.